home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / ststuff.c < prev    next >
C/C++ Source or Header  |  1990-02-28  |  5KB  |  290 lines
  1. /* ststuff.c - atariST tos specific routines */
  2. /* cloned from msstuff */
  3.  
  4. #include "xlisp.h"
  5. #include <osbind.h>
  6.  
  7. #define LBSIZE 200
  8.  
  9. /* external variables */
  10. extern LVAL s_unbound,true;
  11. extern FILE *tfp;
  12. extern int errno;
  13.  
  14. /* make sure we get a large stack */
  15. long _stksize = 65536L;
  16.  
  17. /* local variables */
  18. static char lbuf[LBSIZE];
  19. static int lpos[LBSIZE];
  20. static int lindex;
  21. static int lcount;
  22. static int lposition;
  23. static long rseed = 1L;
  24.  
  25. /* osinit - initialize */
  26. osinit(banner)
  27.   char *banner;
  28. {
  29.     fprintf(stderr, "%s\n",banner);
  30.     lposition = 0;
  31.     lindex = 0;
  32.     lcount = 0;
  33. }
  34.  
  35. /* osfinish - clean up before returning to the operating system */
  36. osfinish()
  37. {
  38. }
  39.  
  40. /* oserror - print an error message */
  41. oserror(msg)
  42.   char *msg;
  43. {
  44.     fprintf(stderr, "error: %s\n",msg);
  45. }
  46.  
  47. /* osrand - return a random number between 0 and n-1 */
  48. int osrand(n)
  49.   int n;
  50. {
  51.     long k1;
  52.  
  53.     /* make sure we don't get stuck at zero */
  54.     if (rseed == 0L) rseed = 1L;
  55.  
  56.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  57.     k1 = rseed / 127773L;
  58.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  59.     rseed += 2147483647L;
  60.  
  61.     /* return a random number between 0 and n-1 */
  62.     return ((int)(rseed % (long)n));
  63. }
  64.  
  65. /* osaopen - open an ascii file */
  66. FILE *osaopen(name,mode)
  67.   char *name,*mode;
  68. {
  69.     return (fopen(name,mode));
  70. }
  71.  
  72. /* osbopen - open a binary file */
  73. FILE *osbopen(name,mode)
  74.   char *name,*mode;
  75. {
  76.     char bmode[10];
  77.     strcpy(bmode,mode); strcat(bmode,"b");
  78.     return (fopen(name,bmode));
  79. }
  80.  
  81. /* osclose - close a file */
  82. int osclose(fp)
  83.   FILE *fp;
  84. {
  85.     return (fclose(fp));
  86. }
  87.  
  88. /* osagetc - get a character from an ascii file */
  89. int osagetc(fp)
  90.   FILE *fp;
  91. {
  92.     return (getc(fp));
  93. }
  94.  
  95. /* osaputc - put a character to an ascii file */
  96. int osaputc(ch,fp)
  97.   int ch; FILE *fp;
  98. {
  99.     return (putc(ch,fp));
  100. }
  101.  
  102. /* osbgetc - get a character from a binary file */
  103. int osbgetc(fp)
  104.   FILE *fp;
  105. {
  106.     return (getc(fp));
  107. }
  108.  
  109. /* osbputc - put a character to a binary file */
  110. int osbputc(ch,fp)
  111.   int ch; FILE *fp;
  112. {
  113.     return (putc(ch,fp));
  114. }
  115.  
  116. /* ostgetc - get a character from the terminal */
  117. int ostgetc()
  118. {
  119.     int ch;
  120.  
  121.     /* check for a buffered character */
  122.     if (lcount--)
  123.     return (lbuf[lindex++]);
  124.  
  125.     /* get an input line */
  126.     for (lcount = 0; ; )
  127.     switch (ch = xgetc()) {
  128.     case '\r':
  129.         lbuf[lcount++] = '\n';
  130.         xputc('\r'); xputc('\n'); lposition = 0;
  131.         if (tfp)
  132.             for (lindex = 0; lindex < lcount; ++lindex)
  133.             osaputc(lbuf[lindex],tfp);
  134.         lindex = 0; lcount--;
  135.         return (lbuf[lindex++]);
  136.     case '\010':
  137.     case '\177':
  138.         if (lcount) {
  139.             lcount--;
  140.             while (lposition > lpos[lcount]) {
  141.             xputc('\010'); xputc(' '); xputc('\010');
  142.             lposition--;
  143.             }
  144.         }
  145.         break;
  146.     case '\032':
  147.         xflush();
  148.         return (EOF);
  149.     case '\024':  /*  control-t */
  150.         xinfo();
  151.         break;
  152.     default:
  153.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  154.             lbuf[lcount] = ch;
  155.             lpos[lcount] = lposition;
  156.             if (ch == '\t')
  157.             do {
  158.                 xputc(' ');
  159.             } while (++lposition & 7);
  160.             else {
  161.             xputc(ch); lposition++;
  162.             }
  163.             lcount++;
  164.         }
  165.         else {
  166.             xflush();
  167.             switch (ch) {
  168.             case '\003':    xltoplevel();    /* control-c */
  169.             case '\007':    xlcleanup();    /* control-g */
  170.             case '\020':    xlcontinue();    /* control-p */
  171.             case '\032':    return (EOF);    /* control-z */
  172.             default:        return (ch);
  173.             }
  174.         }
  175.     }
  176. }
  177.  
  178. /* ostputc - put a character to the terminal */
  179. ostputc(ch)
  180.   int ch;
  181. {
  182.     /* check for control characters */
  183.     oscheck();
  184.  
  185.     /* output the character */
  186.     if (ch == '\n') {
  187.     xputc('\r'); xputc('\n');
  188.     lposition = 0;
  189.     }
  190.     else {
  191.     xputc(ch);
  192.     lposition++;
  193.    }
  194.  
  195.    /* output the character to the transcript file */
  196.    if (tfp)
  197.     osaputc(ch,tfp);
  198. }
  199.  
  200. /* osflush - flush the terminal input buffer */
  201. osflush()
  202. {
  203.     lindex = lcount = lposition = 0;
  204. }
  205.  
  206. /* oscheck - check for control characters during execution */
  207. oscheck()
  208. {
  209.     int ch;
  210.     if (ch = xcheck())
  211.     switch (ch) {
  212.     case '\002':    /* control-b */
  213.         xflush();
  214.         xlbreak("BREAK",s_unbound);
  215.         break;
  216.     case '\003':    /* control-c */
  217.         xflush();
  218.         xltoplevel();
  219.         break;
  220.     case '\024':    /* control-t */
  221.         xinfo();
  222.         break;
  223.     default:
  224.         lbuf[lcount++] = ch;
  225.         break;
  226.     }
  227. }
  228.  
  229. /* xinfo - show information on control-t */
  230. static xinfo()
  231. {
  232.     extern int nfree,gccalls;
  233.     extern long total;
  234.     char buf[80];
  235.     sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %ld ]\n",
  236.         nfree,gccalls,total);
  237.     errputstr(buf);
  238. }
  239.  
  240. /* xflush - flush the input line buffer and start a new line */
  241. static xflush()
  242. {
  243.     osflush();
  244.     ostputc('\n');
  245. }
  246.  
  247. /* xgetc - get a character from the terminal without echo */
  248. static int xgetc()
  249. {
  250.     return (Bconin(2) & 0xFF);
  251. }
  252.  
  253. /* xputc - put a character to the terminal */
  254. static xputc(ch)
  255.   int ch;
  256. {
  257.     Bconout(2,ch);
  258. }
  259.  
  260. /* xcheck - check for a character */
  261. static int xcheck()
  262. {
  263.     if(Bconstat(2))
  264.     return Bconin(2) & 0x0ff;
  265.     else
  266.     return 0;
  267. }
  268.  
  269. /* xsystem - execute a system command */
  270. LVAL xsystem()
  271. {
  272.     char *cmd="";
  273.     if (moreargs())
  274.     cmd = (char *)getstring(xlgastring());
  275.     xllastarg();
  276.     return (system(cmd) == 0 ? true : cvfixnum((FIXTYPE)errno));
  277. }
  278.  
  279. /* xgetkey - get a key from the keyboard */
  280. LVAL xgetkey()
  281. {
  282.     xllastarg();
  283.     return (cvfixnum((FIXTYPE)xgetc()));
  284. }
  285.  
  286. /* ossymbols - enter os specific symbols */
  287. ossymbols()
  288. {
  289. }
  290.